home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / perl / msds-prl / ptchds19.zoo / subproc_c < prev    next >
Text File  |  1992-02-23  |  6KB  |  239 lines
  1. MS-DOS patches to perl.
  2. Apply this patch to the standard perl source, version 4, patch level 19,
  3. using "patch -p."  Do this in the root directory of the perl source
  4. distribution.
  5.  
  6. You can cat all these patches together and pipe the output to patch -p.
  7.  
  8. Len Reed
  9. Holos Software, Inc.
  10. ..!gatech!holos0!lbr
  11. holos0!lbr@gatech.edu
  12. --------------------------------------
  13. *** msdos/subproc.c.old    Sun Feb 23 08:48:16 1992
  14. --- msdos/subproc.c    Thu Nov 14 08:56:40 1991
  15. ***************
  16. *** 0 ****
  17. --- 1,221 ----
  18. + /* RCS      -- $Header: c:/usr/lbr/perl/RCS/subproc.c 1.1 90/10/15 15:14:55 lbr Exp $
  19. + -- SYNOPSIS -- Subprocess control for perl.exe: MS-DOS perl.
  20. + -- 
  21. + -- DESCRIPTION
  22. + --    Interface between programs that want to call system(), etc.,
  23. + --    and the swapping spawnv program.
  24. + --    This code was written for Microsoft C 6.0, but should be
  25. + --    nearly portable across modern MS-DOS compilers.  ANSI
  26. + --    must be understood, and the far keyword must work.
  27. + --
  28. + -- LOG
  29. + --     $Log:    subproc.c $
  30. +  * Revision 1.1  90/10/15  15:14:55  lbr
  31. +  * Initial revision
  32. +  * 
  33. +  * 
  34. + */
  35. + 
  36. + #include <stdlib.h>
  37. + #include <process.h>
  38. + #include <string.h>
  39. + #include <signal.h>
  40. + 
  41. + #include "EXTERN.h"
  42. + #include "perl.h"
  43. + 
  44. + static lookat_env(void);    /* interrogate environment for subshell */
  45. + static char *shell;        /* full path name of $SHELL or $COMSPEC */
  46. + static char *comspec;        /* full path name of $COMSPEC */
  47. + static char *metas;        /* list of chars that are metachars to shell */
  48. + static char *slashc;        /* usually "/c" or "-c", for running subshell */
  49. + char *DirSepStr;        /* what to put between path elements */
  50. + 
  51. + static unsigned short unix_status(unsigned short);
  52. + 
  53. + #ifdef MKS_SUPPORT
  54. + static int mksargs;        /* true if MKSARGS in environ */
  55. + extern char com_slashc[];    /* -c or /c for command.com: set at
  56. +                    startup by inspecting switch char.
  57. +                 */
  58. + #else
  59. + #define mksargs 0
  60. + static char com_slashc[] = "/c";
  61. + #endif
  62. + 
  63. + 
  64. + /* Get value from environment.  Treat null strings as unfound */
  65. + 
  66. + static char *getenv_or_null(char *var)
  67. + {
  68. +     char *rval = getenv(var);
  69. +     if (rval && strcmp(rval,"") == 0)
  70. +         rval = NULL;
  71. +     return rval;
  72. + }
  73. + 
  74. + /* Find defaults from the environment.  Done each time we need them, rather
  75. +    than at startup, so that perl script can change them dynamically.
  76. + */
  77. + 
  78. + static lookat_env(void)
  79. + {
  80. +     shell = getenv_or_null("SHELL");
  81. +     comspec = getenv_or_null("COMSPEC");
  82. +     metas = getenv_or_null("METACHAR");
  83. +     slashc = getenv_or_null("SLASHC");
  84. +     DirSepStr = getenv_or_null("DIRSEP");
  85. + #ifdef MKS_SUPPORT
  86. +     mksargs = getenv("MKSARGS") != NULL;
  87. + #endif
  88. + 
  89. +     if (comspec == NULL)
  90. +     comspec = "\\command.com";
  91. + 
  92. +     if (shell == NULL) {
  93. +         shell = comspec;
  94. +     if (metas == NULL)
  95. +         metas = "|<>";    /* command.com list default */
  96. +     if (DirSepStr == NULL)
  97. +         DirSepStr = "\\";
  98. +     if (slashc == NULL)
  99. +         slashc = com_slashc;    /* contains default switch char */
  100. +     }
  101. +     else {
  102. +     if (metas == NULL)
  103. +         metas = KSH_META_CHARS;      /* Korn shell list default */
  104. +     if (DirSepStr == NULL)
  105. +         DirSepStr = mksargs ? "/" : "\\";
  106. +     if (slashc == NULL)    /* MKS shell needs -e to pass back error code */
  107. +         slashc = mksargs ? "-ce" : "-c";
  108. +     }
  109. + }
  110. + 
  111. + /*
  112. +  * The following code is based on the do_exec and do_aexec functions
  113. +  * in file doio.c
  114. +  */
  115. + 
  116. + int
  117. + do_aspawn(really,arglast)
  118. + STR *really;
  119. + int *arglast;
  120. + {
  121. +     register STR **st = stack->ary_array;
  122. +     register int sp = arglast[1];
  123. +     register int items = arglast[2] - sp;
  124. +     register char **a;
  125. +     char **argv;
  126. +     char *tmps;
  127. +     int status;
  128. + 
  129. +     if (items) {
  130. +     New(1101,argv, items+1, char*);
  131. +     a = argv;
  132. +     for (st += ++sp; items > 0; items--,st++) {
  133. +         if (*st)
  134. +         *a++ = str_get(*st);
  135. +         else
  136. +         *a++ = "";
  137. +     }
  138. +     *a = Nullch;
  139. +     if (really && *(tmps = str_get(really)))
  140. +         status = swap_spawn(mksargs, tmps,argv);
  141. +     else
  142. +         status = swap_spawn(mksargs, argv[0], argv);
  143. +     Safefree(argv);
  144. +     }
  145. +     return unix_status(status);
  146. + }
  147. + 
  148. + int
  149. + do_spawn(char *cmd)
  150. + {
  151. +     register char **a;
  152. +     register char *s;
  153. +     char **argv;
  154. +     char flags[10];
  155. +     int status;
  156. +     char *cmd2;
  157. +     char *sh_argv[4];
  158. + 
  159. +     lookat_env();
  160. + 
  161. +     /* see if there are shell metacharacters in it */
  162. + 
  163. +     if (strcspn(cmd, metas) != strlen(cmd)) {
  164. +         sh_argv[0] = shell;        /* sh.exe, command.com, or whatever */
  165. +         sh_argv[1] = slashc;    /* -c or /c or whatever */
  166. +         sh_argv[2] = cmd;        /* command line as supplied */
  167. +         sh_argv[3] = NULL;
  168. +       doshell:
  169. +         return unix_status(swap_spawn(mksargs, shell, sh_argv));
  170. +     }
  171. + 
  172. +     New(1102,argv, strlen(cmd) / 2 + 2, char*);
  173. + 
  174. +     New(1103,cmd2, strlen(cmd) + 1, char);
  175. +     strcpy(cmd2, cmd);
  176. +     a = argv;
  177. +     for (s = cmd2; *s;) {
  178. +     while (*s && isspace(*s)) s++;
  179. +     if (*s)
  180. +         *(a++) = s;
  181. +     while (*s && !isspace(*s)) s++;
  182. +     if (*s)
  183. +         *s++ = '\0';
  184. +     }
  185. +     *a = Nullch;
  186. +     if (argv[0]) {
  187. +     status = swap_spawn(mksargs, argv[0], argv);
  188. +     Safefree(cmd2);
  189. +     Safefree(argv);
  190. +     switch (status) {
  191. +         case -2:
  192. +         sh_argv[0] = comspec;      /* command.com or whatever */
  193. +         sh_argv[1] = com_slashc;  /* -c or /c or whatever */
  194. +         sh_argv[2] = cmd;      /* command line as supplied */
  195. +         sh_argv[3] = NULL;
  196. +         goto doshell;
  197. + 
  198. +         case -3:
  199. +             sh_argv[0] = shell;    /* shell script */
  200. +         sh_argv[1] = cmd;    /* command line as supplied */
  201. +         sh_argv[2] = NULL;
  202. +         goto doshell;
  203. +     }
  204. +     status = unix_status(status);
  205. +     }
  206. +     return status;
  207. + }
  208. + 
  209. + /* Convert status as returned by MS-DOS int 21h, function 4dh call
  210. +    to the unix wait(2) style expected by perl.
  211. + */
  212. + 
  213. + static unsigned short unix_status(unsigned short dos_status)
  214. + {
  215. +     unsigned short result;
  216. + 
  217. +     switch (dos_status & 0xFF00) {
  218. +         case 0xFF00:        /* didn't find the program to run */
  219. +         result = 0xFF00;    /* simulate child doing _exit(-1) */
  220. +         break;
  221. + 
  222. +         case 0x100:        /* control break exit */
  223. +         result = SIGINT;    /* child saw SIGINT */
  224. +         raise(SIGINT);    /* keyboard signal to parent, too */
  225. +         break;
  226. + 
  227. +     default:        /* undefined */
  228. +     case 0x200:        /* critical error death */
  229. +         result = SIGABRT;
  230. +         break;
  231. + 
  232. +     case 0x300:        /* TSR exit! */
  233. +     case 0:            /* child ran to completion */
  234. +         result = dos_status << 8;    /* DOS uses low byte, unix high */
  235. +         break;
  236. +     }
  237. +     return result;
  238. + }
  239.